googologywikiaorg-20200223-history
User blog:Rgetar/Ordinal Explorer v7.0
Today I created program Ordinal Explorer v7.0 working with booster-base (BB) expressions. Source code Delphi 7 source code. unit OrdEx; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StrUtils, Math, ScktComp; type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Label2: TLabel; Label3: TLabel; ServerSocket1: TServerSocket; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Edit1: TEdit; Edit2: TEdit; procedure Button1Click(Sender: TObject); procedure Serversocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure Form1Create(Sender: TObject); procedure Form1Destroy(Sender: TObject); end; lis=array of record s: string; c,l,n: integer; end; rar=array0..19 of string; var Form1: TForm1; st,st1,bo,cout,qhost,fa,col,ercode: string; s: lis; f: textfile; b,bn,g,er: boolean; cn,cl,sl,br: integer; duq,uq,bro,brc: rar; implementation {$R *.dfm} // get position of last symbol p of string st (if l=true then first) function getls(st,p:string; l:boolean=false):integer; var e,np: integer; begin if length(st)=0 then result:=ifthen(l,1,0) else begin if l then e:=0 else e:=length(st)+1; np:=0; repeat if l then inc(e) else dec(e); if ste='then dec(np); if st[e=']' then inc(np); until (not l and (e=1)) or (l and (e=length(st))) or ((ste=p) and (np=0)); if not l and (e=1) and (st1<>p) then e:=0 else if l and (e=length(st)) and (ste<>p) then e:=length(st)+1; result:=e; end; end; // create boosterbase string function bb(booster,base:string):string; begin result:=''+booster+''+base; end; // get base of string st function base(st:string):string; begin result:=copy(st,getls(st,']',true)+1,length(st)); end; // get booster of string st function booster(st:string):string; begin result:=copy(st,2,getls(st,']',true)-2); end; // get successor of ordinal st function suc(st:string):string; begin result:='[]'+st; end; // get predecessor of successor ordinal st = X + 1 function pred(st:string):string; begin result:=copy(st,3,length(st)); end; // finite ordinal string st to number function fostn(st:string):integer; begin if st='' then result:=0 else result:=(length(st)+1) div 2; end; // finite ordinal e from integer to computer format function cf(e:integer):string; begin result:=''; while e>0 do begin dec(e); result:=suc(result); end; end; // compare expressions st1, st2 (if st1st2 then 1) function compare(st1,st2:string):shortint; begin if st1=st2 then result:=0 else result:=ifthen(reversestring(st1)>reversestring(st2),1,-1); end; // delete all boosters of b < b, add a booster function bbc(a,b:string):string; begin while (b<>'') and (b<>col) and (compare(a,booster(b))=1) do b:=base(b); result:=''+a+''+b; end; function rest(l,st:string):string; begin if compare(l,st)=1 then result:=st else result:=rest(l,booster(st)); end; function ceill(l,st:string):string; begin if compare(l,st)=1 then result:=l else result:=bbc(ceill(l,booster(st)),st); end; function ledge(st:string):string; var x:string; begin x:=booster(st); if compare(col,x)=1 then result:=col else result:=bbc(ceill(col,x),base(st)); end; function fs(st,n:string):string;forward; function cof(st:string):string;forward; function cascade(x,c,st:string):string; var y,d:string; begin y:=booster©; d:=cof(y); if (d=col) or (d=ledge©) then result:=bb(fs(y,rest(d,x)),base©) else result:=cascade(y,d,c); result:=bb(fs(x,result),base(st)); end; // get cofinality of ordinal st function cof; var x,c,l:string; ca:integer; begin result:='[[]]'; if st<>bo then // L if (st='') or (st=col) then // 1, 6 result:=st else begin x:=booster(st); if x='' then // 2 result:='[]' else begin c:=cof(x); if c<>'[]' then // 3 if compare(st,col)=1 then // > C result:=c else begin l:=ledge(st); if compare(l,c)<1 then result:=st // 7 else begin ca:=compare(bbc(ceill(l,x),base(st)),c); if ca=1 then // 4, 5, 8 result:=c else if ca<0 then // 9 result:=cof(cascade(x,c,st)); end; end; end; end; end; // get n-th element of fs of ordinal st function fs; var beta,x,c,l:string; i,ca:integer; begin result:=n; if st=bo then // L begin result:=col; for i:=1 to fostn(n) do result:=bb(result,col); for i:=1 to 2 do result:=bb(result,); end else if (st<>) and (st<>col) then // 1, 6 begin x:=booster(st); beta:=base(st); if x='' then // 2 result:=beta else begin c:=cof(x); if c='[]' then // 3 begin result:=beta; x:=base(x); for i:=1 to fostn(n) do result:=bb(x,result); end else if compare(st,col)=1 then // > C result:=bb(fs(x,n),beta) else begin l:=ledge(st); if compare(l,c)=1 then // 7 begin ca:=compare(bbc(ceill(l,x),base(st)),c); if ca=1 then // 4, 5, 8 result:=bb(fs(x,n),beta) else if ca=0 then // 9 begin result:=beta; for i:=1 to fostn(n) do result:=bb(fs(x,result),beta); end else result:=fs(cascade(x,c,st),n); end; end; end; end; end; function convert(st:string;z:boolean=false):string; begin result:=stringreplace(st,col,'C',rfReplaceAll); end; // small expansion of pair c > l function se(c,l:string; yn:integer; var n:string):string; var u:integer; begin repeat result:=fs(c,n); n:=suc(n); if length(n)>35 then er:=true; until er or (l='-') or (compare(result,l)=1); if er then begin ercode:='fs is less than or equal to low element of pair'; form1.Edit1.Text:=c; form1.Edit2.Text:=l; end else if cof©<>'1' then begin for u:=3 to yn do n:=suc(n); if yn>1 then result:=fs(c,n); end; end; // levelup (q - number of levelups, yn - number of fs elements, inserted in last levelup) procedure levelup(q:integer; yn:integer=0); var e,i,y,u,j: integer; n,l,p,a,c: string; begin inc(yn); while not er and (q>0) do begin dec(q); if q>0 then j:=1 else j:=yn; e:=0; c:=se.s; i:=se.c; y:=0; form1.Label2.Caption:=inttostr(cn)+' '; form1.Label2.Refresh; repeat begin n:=cf(se.n); if i=-1 then begin l:='-'; p:=''; end else begin l:=si.s; p:=suc(l); end; if (c<>bo) and (compare(c,p)=0) then begin e:=i; if e>-1 then begin c:=se.s; i:=se.c; if i=-1 then e:=i; end; dec(cn); form1.Label2.Caption:=inttostr(cn)+' '; form1.Label2.Refresh; end else begin a:=se(c,l,j,n); se.n:=fostn(n); if cof©='[]' then u:=j-1 else u:=0; if (c<>bo) and (compare(c,a)<1) then begin er:=true; if compare(c,a)=0 then ercode:='fs element is equal to its argument' else ercode:='fs element is larger than its argument'; form1.Edit1.Text:=c; form1.Edit2.Text:=a; end; if er then form1.Label8.Caption:='Error: '+ercode else while ulength(s) then setlength(s,length(s)*2); form1.Label1.Caption:=inttostr(sl); form1.Label1.Refresh; e:=y; se.c:=i; se.s:=a; se.l:=ifthen(u=j,cl,cl+1); se.n:=0; if u<>j then begin n:=pred(n); a:=fs(c,n); end; end; c:=a; end; end; until er or (e=-1); //until er or (e=-1) or (sl>1000); cn:=y; inc(cl); end; end; function ruq(st:string;uq:rar):rar; var e,i:integer; begin st:=st+'='; result:=uq; while (st<>'=') and (st<>'') do begin e:=system.ord(st1)-48; delete(st,1,1); i:=pos('=',st); resulte:=leftstr(st,i-1); delete(st,1,i); end; end; function wuq(st:string):string; var e:integer; huq:rar; begin huq:=ruq(st,uq); result:=''; for e:=0 to length(uq)-1 do if huqe<>duqe then begin if result<>'' then result:=result+'='; result:=result+chr(e+48)+huqe; end; end; // get html link s, displaying string st function getrefs(s, st: string):string; begin result:=''+st+''; end; procedure ads(st:string); begin if g then cout:=cout+st else writeln(f,st); end; procedure starthtml; begin cout:=''; st:=''; //st:=' '+st; st:=' '+st; st:='sup {font-size: 0.83rem;}'+st; st:='sub {font-size: 0.83rem;}'+st; st:='